home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / surfsrc3.zip / COLORMOD.INC < prev    next >
Text File  |  1989-08-10  |  5KB  |  143 lines
  1. procedure COLORMOD (Shade: real; Systemm: integer; Color: integer;
  2.   var Pcolor, Fmod: integer);
  3. { Produce a "plotting color" and "mod number", given the requested
  4.   color and shade.  The mod number is used to produce a simple dither
  5.   pattern.  Pcolormod works as follows:
  6.  
  7.   -- For a system with less than 3 colors, it halts the program with
  8.      an error message because this procedure should never have been
  9.      called (dithering should be used).
  10.   -- For a system with 3-6 colors, Pcolormod ignores the requested
  11.      color and generates a plotting color and mod number that work
  12.      in conjunction to produce 7 unique shades of grey on a monochrome
  13.      monitor.
  14.   -- For a system with 7-14 colors, Pcolormod does basically the same
  15.      thing as with 3-6 colors, but produces 11 unique shades of grey.
  16.      This is based on intensity tests on the Sanyo MBC-555.
  17.   -- For a system with 15-63 colors, it is suggested the user come
  18.      up with a good intensity table for monochrome monitors that will
  19.      produce many unique shades of grey without using the mod number.
  20.   -- For a system with 64 colors or more, an example is given of a
  21.      fictitious system that allows the user to request colors in the
  22.      range of 1-8, but returns a plotting color in the range 1-Ncolors
  23.      by assuming the system has (Ncolors/8) intensities available for
  24.      each of the 8 colors.  If the ordering is not right, you will have
  25.      to form your own lookup table.
  26.  
  27. **************************************************************************
  28. NOTE that Colormod is only called if the dithering option is not selected.
  29. **************************************************************************
  30. }
  31. var Tcolor: integer;        { temp for Color }
  32.     Nshade: integer;        { #available shades of each color }
  33.     Pshade: integer;        { shade # within a color }
  34. begin
  35.   if (Ncolors < 3) then begin
  36.     writeln ('Error: COLORMOD called with Ncolors = ',Ncolors);
  37.     writeln ('Internal error; get help!');
  38.     halt;
  39.   end else if (Ncolors < 7) then begin
  40.     { IBM Color Graphics Adapter in lo-res 4-color mode }
  41.     { This routine uses 3 colors and some simple dithering to create
  42.       7 shades of grey on a monochrome screen }
  43.     if (Shade = 0.0) then begin
  44.       Pcolor := 0;
  45.       Fmod := 1;
  46.     end else case trunc (Shade * 6.0) of
  47.       0: begin
  48.         Pcolor := 1;
  49.         Fmod := 3;
  50.       end;
  51.       1: begin
  52.         Pcolor := 1;
  53.         Fmod := 2;
  54.       end;
  55.       2: begin
  56.         Pcolor := 1;
  57.         Fmod := 1;
  58.       end;
  59.       3: begin
  60.         Pcolor := 3;
  61.         Fmod := 3;
  62.       end;
  63.       4: begin
  64.         Pcolor := 3;
  65.         Fmod := 2;
  66.       end
  67.       else begin
  68.         Pcolor := 3;
  69.         Fmod := 1;
  70.       end;
  71.     end; { case }
  72. { end else if (Ncolors < 15) then begin }
  73. { The above line should be substituted for the line below if someone
  74.   comes up with a good color intensity table for a 15-color system.
  75.   Note that if you are adding code for a 15-color table, Fmod can
  76.   always be 1; dithering is not necessary if you have that many
  77.   intensities available.
  78. }
  79.   end else if (Ncolors < 64) then begin
  80.     { This routine uses 7 colors and some simple dithering to create
  81.       11 shades of grey on a monochrome screen }
  82.     if (Shade = 0.0) then begin
  83.       Pcolor := 0;
  84.       Fmod := 1;
  85.     end else case trunc (Shade * 10.0) of
  86.       0: begin
  87.         Pcolor := 1;
  88.         Fmod := 2;
  89.       end;
  90.       1: begin
  91.         Pcolor := 4;
  92.         Fmod := 2;
  93.       end;
  94.       2: begin
  95.         Pcolor := 2;
  96.         Fmod := 2;
  97.       end;
  98.       3: begin
  99.         Pcolor := 2;
  100.         Fmod := 1;
  101.       end;
  102.       4: begin
  103.         Pcolor := 5;
  104.         Fmod := 1;
  105.       end;
  106.       5: begin
  107.         Pcolor := 7;
  108.         Fmod := 2;
  109.       end;
  110.       6: begin
  111.         Pcolor := 6;
  112.         Fmod := 1;
  113.       end;
  114.       7: begin
  115.         Pcolor := 7;
  116.         Fmod := -3;
  117.       end;
  118.       8: begin
  119.         Pcolor := 7;
  120.         Fmod := -4;
  121.       end
  122.       else begin
  123.         Pcolor := 7;
  124.         Fmod := 1;
  125.       end;
  126.     end; { case }
  127.   end else begin
  128.     Fmod := 1;
  129.     { A fictitious system of Ncolors colors: }
  130.     if (Color > 8) then
  131.       Tcolor := 8
  132.     else
  133.       Tcolor := Color;
  134.     Nshade := Ncolors div 8 - 1;
  135.     Pshade := round (Shade * Nshade);
  136.     if (Pshade < 0) then
  137.       Pshade := 0
  138.     else if (Pshade > Nshade) then
  139.       Pshade := Nshade;
  140.     Pcolor := (Tcolor-1) * (Nshade+1) + Pshade;
  141.   end; { if Ncolors }
  142. end; { procedure COLORMOD }
  143.